home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / walpeep / wallpeep.frm < prev    next >
Text File  |  1995-05-08  |  13KB  |  484 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "WallPeeper"
  5.    ClientHeight    =   3960
  6.    ClientLeft      =   105
  7.    ClientTop       =   690
  8.    ClientWidth     =   4455
  9.    FillColor       =   &H00010000&
  10.    ForeColor       =   &H00808080&
  11.    Height          =   4650
  12.    Icon            =   WALLPEEP.FRX:0000
  13.    Left            =   45
  14.    LinkMode        =   1  'Source
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    ScaleHeight     =   264
  18.    ScaleMode       =   3  'Pixel
  19.    ScaleWidth      =   297
  20.    Top             =   60
  21.    Width           =   4575
  22.    Begin CheckBox ShowAllFiles 
  23.       Caption         =   "Show all usable files on C"
  24.       FontBold        =   0   'False
  25.       FontItalic      =   0   'False
  26.       FontName        =   "MS Sans Serif"
  27.       FontSize        =   8.25
  28.       FontStrikethru  =   0   'False
  29.       FontUnderline   =   0   'False
  30.       Height          =   255
  31.       Left            =   75
  32.       TabIndex        =   13
  33.       Top             =   2910
  34.       Width           =   2175
  35.    End
  36.    Begin CheckBox TileChecked 
  37.       Caption         =   "Tile"
  38.       FontBold        =   0   'False
  39.       FontItalic      =   0   'False
  40.       FontName        =   "MS Sans Serif"
  41.       FontSize        =   8.25
  42.       FontStrikethru  =   0   'False
  43.       FontUnderline   =   0   'False
  44.       Height          =   255
  45.       Left            =   75
  46.       TabIndex        =   12
  47.       Top             =   3630
  48.       Value           =   1  'Checked
  49.       Width           =   735
  50.    End
  51.    Begin PictureBox Picture2 
  52.       AutoRedraw      =   -1  'True
  53.       AutoSize        =   -1  'True
  54.       Height          =   450
  55.       Left            =   1440
  56.       ScaleHeight     =   28
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   33
  59.       TabIndex        =   11
  60.       Top             =   4200
  61.       Width           =   525
  62.    End
  63.    Begin CheckBox ResizableChecked 
  64.       Caption         =   "Resizable"
  65.       FontBold        =   0   'False
  66.       FontItalic      =   0   'False
  67.       FontName        =   "MS Sans Serif"
  68.       FontSize        =   8.25
  69.       FontStrikethru  =   0   'False
  70.       FontUnderline   =   0   'False
  71.       Height          =   240
  72.       Left            =   2400
  73.       TabIndex        =   10
  74.       Top             =   4320
  75.       Value           =   1  'Checked
  76.       Width           =   1485
  77.    End
  78.    Begin Timer Timer1 
  79.       Left            =   930
  80.       Top             =   5925
  81.    End
  82.    Begin PictureBox Picture1 
  83.       AutoRedraw      =   -1  'True
  84.       AutoSize        =   -1  'True
  85.       BorderStyle     =   0  'None
  86.       Height          =   450
  87.       Left            =   240
  88.       ScaleHeight     =   30
  89.       ScaleMode       =   3  'Pixel
  90.       ScaleWidth      =   35
  91.       TabIndex        =   4
  92.       Top             =   4200
  93.       Width           =   525
  94.    End
  95.    Begin FileListBox File2 
  96.       Height          =   810
  97.       Left            =   2475
  98.       Pattern         =   "*.bmp;*.ico;*.wmf;*.rle;*.dib"
  99.       TabIndex        =   7
  100.       Top             =   4755
  101.       Width           =   1845
  102.    End
  103.    Begin DirListBox Dir2 
  104.       Height          =   900
  105.       Left            =   60
  106.       TabIndex        =   6
  107.       Top             =   4755
  108.       Width           =   2280
  109.    End
  110.    Begin CommandButton Command1 
  111.       Caption         =   "Set as Wallpaper"
  112.       Default         =   -1  'True
  113.       Height          =   315
  114.       Left            =   75
  115.       TabIndex        =   9
  116.       Top             =   3240
  117.       Width           =   4275
  118.    End
  119.    Begin CommandButton Command2 
  120.       Caption         =   "Refresh List"
  121.       Enabled         =   0   'False
  122.       Height          =   315
  123.       Left            =   2430
  124.       TabIndex        =   3
  125.       Top             =   2880
  126.       Visible         =   0   'False
  127.       Width           =   1920
  128.    End
  129.    Begin DirListBox Dir1 
  130.       ForeColor       =   &H00000000&
  131.       Height          =   2280
  132.       Left            =   75
  133.       TabIndex        =   0
  134.       Top             =   555
  135.       Width           =   2295
  136.    End
  137.    Begin ListBox List1 
  138.       Enabled         =   0   'False
  139.       Height          =   2760
  140.       Left            =   2445
  141.       Sorted          =   -1  'True
  142.       TabIndex        =   5
  143.       Top             =   75
  144.       Visible         =   0   'False
  145.       Width           =   1905
  146.    End
  147.    Begin FileListBox File1 
  148.       Height          =   2760
  149.       Left            =   2445
  150.       Pattern         =   "*.bmp;*.ico;*.wmf;*.rle;*.dib"
  151.       TabIndex        =   1
  152.       Top             =   75
  153.       Width           =   1905
  154.    End
  155.    Begin DriveListBox Drive1 
  156.       Height          =   315
  157.       Left            =   75
  158.       TabIndex        =   2
  159.       Top             =   75
  160.       Width           =   2295
  161.    End
  162.    Begin Label Label1 
  163.       Alignment       =   1  'Right Justify
  164.       Height          =   240
  165.       Left            =   2970
  166.       TabIndex        =   8
  167.       Top             =   2940
  168.       Visible         =   0   'False
  169.       Width           =   1335
  170.    End
  171.    Begin Menu FileMenu 
  172.       Caption         =   "File"
  173.       Begin Menu FileExit 
  174.          Caption         =   "E&xit"
  175.       End
  176.       Begin Menu FileSep 
  177.          Caption         =   "-"
  178.       End
  179.       Begin Menu FileAbout 
  180.          Caption         =   "&About WallPeeper..."
  181.       End
  182.    End
  183. End
  184. DefInt A-Z
  185. Declare Function GetVersion Lib "Kernel" () As Long
  186.  
  187. Declare Function GetWindowsDirectory Lib "kernel" (ByVal P$, ByVal S)
  188. Declare Sub SystemParametersInfo Lib "User" (ByVal wAction%, ByVal wParam%, lParam As Any, ByVal fWinIni%)
  189. Declare Function WriteProfileString% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpString$)
  190.  
  191. Const SPI_SETDESKWALLPAPER = 20
  192. Const SPIF_UPDATEINIFILE = 1     'update Win.ini Const
  193. Const SPIF_SENDWININICHANGE = 2  'update Win.ini and tell everyone
  194.  
  195. Sub Command1_Click ()
  196. OldMouseP = Screen.MousePointer
  197. Screen.MousePointer = 11
  198. Dim WinPath As String
  199. BmpFile$ = "WALLPEEP.BMP"
  200. WinPath = String$(145, Chr$(0))
  201. T% = GetWindowsDirectory(WinPath, Len(WinPath))
  202. WinPath = Left$(WinPath, T%)
  203.  
  204. Call DragPictureTo((Form2.DestinationPic.Width), (Form2.DestinationPic.Height), False)
  205. Form1.Picture2.Picture = Form2.DestinationPic.Image
  206. Call DottedLine
  207. Form1.Picture2.Width = Form2.DestinationPic.Width
  208. Form1.Picture2.Height = Form2.DestinationPic.Height
  209. Form1.Picture2.ScaleWidth = Form2.DestinationPic.ScaleWidth
  210. Form1.Picture2.ScaleHeight = Form2.DestinationPic.ScaleHeight
  211. SavePicture Form1.Picture2.Image, WinPath + "\" + BmpFile$
  212. '[Desktop]
  213. 'Pattern = (None)
  214. 'Wallpaper=C:\WINDOWS\WALLVIEW.BMP
  215. 'GridGranularity = 0
  216. 'IconSpacing = 93
  217. 'TileWallPaper = 1
  218.  
  219. If Form1.TileChecked.Value = 0 Then
  220.    T% = WriteProfileString%("Desktop", "TileWallPaper", "0")
  221. Else
  222.    T% = WriteProfileString%("Desktop", "TileWallPaper", "1")
  223. End If
  224.  
  225. SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal WinPath + "\" + BmpFile$, SPIF_UPDATEINIFILE
  226. Screen.MousePointer = OldMouseP
  227. End Sub
  228.  
  229. Sub Command2_Click ()
  230. Command2.Enabled = False
  231. OldMousePointer = Screen.MousePointer
  232. Screen.MousePointer = 11
  233. Call FillList
  234. Screen.MousePointer = OldMousePointer
  235. End Sub
  236.  
  237. Sub Dir1_Change ()
  238. File1.Path = Dir1.Path
  239. End Sub
  240.  
  241. Sub Dir1_Click ()
  242. Dir1.Path = Dir1.List(Dir1.ListIndex)
  243. End Sub
  244.  
  245. Sub Drive1_Change ()
  246. On Error Resume Next
  247. If SavedDrive$ = Drive1.Drive Then Exit Sub
  248. Dir1.Path = Drive1.Drive
  249. If Err <> 0 Then
  250.    On Error Resume Next
  251.    MsgBox "Error reading drive " + Drive1.Drive
  252.    Drive1.Drive = SavedDrive$
  253.    On Error Resume Next
  254.    Dir1.Path = Drive1.Drive
  255.    On Error GoTo 0
  256.    Exit Sub
  257. End If
  258. On Error GoTo 0
  259.  
  260. If (List1.ListCount > 0) And (SavedDrive$ <> Drive1.Drive) Then
  261.    ClearListBox Form1.List1
  262. End If
  263. SavedDrive$ = Drive1.Drive
  264. T$ = ShowAllFiles.Caption
  265. Mid$(T$, Len(T$), 1) = UCase$(Drive1.Drive)
  266. ShowAllFiles.Caption = T$
  267.    
  268.  
  269. If ShowAllFiles.Value = False Then
  270. Else
  271.    OldMousePointer = Screen.Mo